home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Graphics / Graphic Demos / Ising Dynamics / IsingGraf.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1986-12-15  |  28.4 KB  |  1,060 lines  |  [TEXT/ttxt]
  1. PROGRAM IsingGraf;
  2. {This program displays a changing Ising model field of any size from 2x2 to}
  3. {300x300.  Menus are used to select field size, temperature, initial setup,}
  4. {and other options.}
  5.  
  6. USES MacIntf;     {basic Mac interface files}
  7.      
  8.      {$L IsingGraf.rsrc }       {link in resources}
  9.      {$B+}                      {set bundle bit}
  10.      {$T 'APPL' 'GENE'}         {set type and creator}
  11.  
  12. CONST
  13.   MaxN = 300;         {The maximum number of rows and column allowed}
  14.   TSize = 8;          {size of the Exp lookup table (Max DeltaE = 8)}
  15.   RandRange = 32767;  {max size of number in lookup table}
  16.   WaitCount = 1000;   {number of loops in wait loop}
  17.  
  18.  
  19.  
  20.  
  21. {support constants start here}
  22.       
  23.       appleID = 128;     {resource IDs/menu IDs for menus}
  24.       fileID  = 129;
  25.       editID  = 130;
  26.       Menu1ID = 131;
  27.       Menu2ID = 132;
  28.  
  29.       appleM = 1;        {index for each menu in myMenus (array of menu handles)}
  30.       fileM  = 2;
  31.       editM  = 3;
  32.       FirstM = 4;
  33.       SecondM = 5;
  34.  
  35.       menuCount = 5;     {total number of menus}
  36.  
  37.       windowID = 128;    {resource ID for main window}
  38.  
  39.       undoCommand  = 1;
  40.       {blank item 2}
  41.       cutCommand   = 3;
  42.       copyCommand  = 4;
  43.       pasteCommand = 5;
  44.       clearCommand = 6;
  45.       {blank item 7}
  46.       cSpecialCommand = 8; {constants identifying commands in Edit menu}
  47.  
  48.       M1NewSize = 1;
  49.       M1NewTemp = 2;
  50.       {blank item 3}
  51.       M1YesAve = 4;
  52.       M1NoAve = 5;
  53.       M1NewAve = 6;
  54.       {blank item 7}
  55.       M1Speed = 8;         {constants identifying commands in Control menu}
  56.       
  57.       M2Item1 = 1;
  58.       M2Item2 = 2;
  59.       M2Item3 = 3;
  60.       M2Item4 = 4;
  61.       M2Item5 = 5;
  62.       M2Item6 = 6;
  63.       M2Item7 = 7;
  64.       M2Item8 = 8;         {constants identifying commands in Setup menu}
  65.  
  66.       tempName = 'Delete Me';  {name of the stupid text file}
  67.       
  68.       
  69. TYPE
  70.   Rowtype = ARRAY[0..MaxN] of INTEGER;  {The spins}
  71.   RowPtr = ^Rowtype;                    {pointer to a row of spins}
  72.  
  73. VAR 
  74.   Field: ARRAY[0..MaxN] OF RowPtr;      {the field}
  75.  
  76.   N: INTEGER;         {number of rows and columns minus 1}
  77.   
  78.   NSteps: LongInt;    {the number of integration steps done so far}
  79.   invNSteps: REAL;    {1/NSteps, sometimes when needed for averaging}
  80.   FewSteps: INTEGER;  {a "Small" number of integration steps}
  81.   
  82.   Averaging: BOOLEAN; {TRUE if we are displaying averages}
  83.   VeryBig: BOOLEAN;   {TRUE if the field is too big to average with LongInt}
  84.   Speed: INTEGER;
  85.   
  86.   Spacing: INTEGER;
  87.   hOffset: INTEGER;
  88.   vOffset: INTEGER;   {parameters for display of the field}
  89.  
  90.   kToJ : REAL;        {The T* parameter (kToverJ)}
  91.   Nm1 : INTEGER;      {number of rows and columns minus 2}
  92.   Np1 : INTEGER;      {number of rows and columns}
  93.   NSpins : LongInt;   {the number of spins}
  94.  
  95.   ExpLookup : ARRAY[1..TSize] OF INTEGER;  {lookup table FOR accept}
  96. {This table is ExpLookup[i] = Round(RandRange*Exp(i/kToJ)-0.5), so if}
  97. {ExpLookup[DeltaE] >= Random (=a random number from 0-RandRange),}
  98. {The correct decision will be made on whether to accept or reject}
  99.  
  100.   tEAve, tESqAve, tSpinAve : REAL;  {temp. values from integration}
  101.   EAve, ESqAve, SpinAve : REAL;     {average values}
  102.  
  103.   CurE : LongInt;         {The current total energy}
  104.   CurESq : LongInt;       {The current total energy squared}
  105.   CurSpin : LongInt;      {The current total spin}
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112. {support variables start here}
  113.  
  114.     myMenus: ARRAY[1..menuCount] OF MenuHandle; {array of handles to the menus}
  115.     dragRect: Rect;         {rectangle used to mark boundaries for dragging window}
  116.     theChar: CHAR;          {character typed on the keyboard or keypad}
  117.     myEvent: EventRecord;   {information about an event}
  118.     GenWRecord: WindowRecord;{information about the main window}
  119.     GenWind: WindowPtr;     {pointer to GenWRecord of RD window}
  120.     whichWindow: WindowPtr; {pointer to window in which mouse button was pressed}
  121.     hCurs: CursHandle;      {temp cursor handle}
  122.     iBeam: Cursor;          {I-beam cursor (from resource file)}
  123.     extended: BOOLEAN;      {TRUE if user is Shift-clicking}
  124.     linteger: LONGINT;      {temporary longints}
  125.     tComp: Comp;            {tempoorary computation}
  126.     
  127.  
  128.     i,j: INTEGER;           {junk integers}
  129.     TempRect: Rect;         {junk rectangles}
  130.     tempStr: Str255;        {junk strings}
  131.     SavePort: GrafPtr;      {temporary save of grafport}
  132.     myPict: PicHandle;      {picture to be copied to scrap}
  133.  
  134.     tFile : text;           {a stupid text file}
  135.  
  136.  
  137.  
  138. {----------------------------------------------------------------------------------}
  139. {content procedure and functions start here}
  140.  
  141.  FUNCTION Energy : LongInt;
  142. {Returns the total energy of the Field in units of J}
  143. {MOD operators are not used, in order to save time.  The wrap-arounds}
  144. {are handled with separate loops.}
  145.  VAR
  146.    i, j : INTEGER;
  147.    Sum : LongInt;
  148.  BEGIN
  149.   Sum := 0;
  150.   FOR i := 0 TO Nm1 DO
  151.    BEGIN
  152.     FOR j := 0 TO Nm1 DO
  153.      Sum := Sum - Field[i]^[ j] * (Field[i]^[ j + 1] + Field[i + 1]^[ j]);
  154.    END;
  155.   FOR i := 0 TO Nm1 DO
  156.    Sum := Sum - Field[i]^[ N] * (Field[i]^[ 0] + Field[i + 1]^[ N]);
  157.                                                            {get Row wrap-arounds}
  158.   FOR j := 0 TO Nm1 DO
  159.    Sum := Sum - Field[N]^[ j] * (Field[0]^[ j] + Field[N]^[ j + 1]);
  160.                                                            {get Column wrap-arounds}
  161.   Energy := Sum - Field[N]^[ N] * (Field[N]^[ 0] + Field[0]^[ N]);
  162.                                                            {get very last wrap-arounds}
  163.  END;
  164.  
  165.  FUNCTION Spin : LongInt;
  166. {Returns the total net spin in the field}
  167.   VAR
  168.    i, j : INTEGER;
  169.    Sum : LongInt;
  170.  BEGIN
  171.   Sum := 0;
  172.   FOR i := 0 TO N DO
  173.    FOR j := 0 TO N DO
  174.     Sum := Sum + Field[i]^[ j];
  175.   Spin := Sum;
  176.  END;
  177.  
  178.  
  179. PROCEDURE SetValues;
  180. {Sets the current values of the energy and spin variables.}
  181. BEGIN
  182.  CurE := Energy;         {Start with the energy of the initial configuration}
  183.  CurESq := CurE * CurE;
  184.  CurSpin := Spin;        {Start with the spin of the initial configuration}
  185.  EAve := 0;
  186.  ESqAve := 0;
  187.  SpinAve := 0;           {zero the accumulating averages varaibles}
  188.  NSteps := 0;
  189. END;
  190.  
  191.  PROCEDURE RandField;
  192. {randomly sets all the spins to up or down, 50% in each}
  193.   VAR
  194.    i, j : INTEGER;
  195.  BEGIN
  196.   FOR i := 0 TO N DO
  197.    FOR j := 0 TO N DO
  198.     IF Random > 0 THEN
  199.      Field[i]^[j] := 1
  200.     ELSE
  201.      Field[i]^[ j] := -1;
  202.  SetValues;
  203.  END;
  204.  
  205.  PROCEDURE CheckField;
  206. {sets up the spins with a checkerboard pattern}
  207.   VAR
  208.    i, j : INTEGER;
  209.  BEGIN
  210.   FOR i := 0 TO N DO
  211.    FOR j := 0 TO N DO
  212.     IF ((i+j) MOD 2) > 0 THEN
  213.      Field[i]^[ j] := 1
  214.     ELSE
  215.      Field[i]^[ j] := -1;
  216.  SetValues;
  217.  END;
  218.  
  219.  PROCEDURE IntfField;
  220. {sets up the spins with a vertical interface}
  221.   VAR
  222.    i, j : INTEGER;
  223.    No2: INTEGER;
  224.  BEGIN
  225.   No2 := N DIV 2;
  226.   FOR i := 0 TO N DO
  227.    FOR j := 0 TO N DO
  228.     IF j >= No2 THEN
  229.      Field[i]^[ j] := 1
  230.     ELSE
  231.      Field[i]^[ j] := -1;
  232.  SetValues;
  233.  END;
  234.  
  235.  PROCEDURE SpotField;
  236. {sets up the spins with a big spot in the middle}
  237.   VAR
  238.    i, j : INTEGER;
  239.    No2: INTEGER;
  240.  BEGIN
  241.   No2 := N DIV 2;
  242.   FOR i := 0 TO N DO
  243.    FOR j := 0 TO N DO
  244.     IF ((i-No2)*(i-No2)+(j-No2)*(j-No2)) <= No2*No2 THEN
  245.      Field[i]^[ j] := 1
  246.     ELSE
  247.      Field[i]^[ j] := -1;
  248.  SetValues;
  249.  END;
  250.  
  251.  PROCEDURE RingField;
  252. {sets up the spins with a ring around the outside}
  253.   VAR
  254.    i, j : INTEGER;
  255.  BEGIN
  256.   FOR i := 0 TO N DO
  257.    FOR j := 0 TO N DO
  258.      Field[i]^[j] := -1;
  259.      
  260.   FOR i := 0 TO N DO
  261.     BEGIN
  262.     Field[i]^[0] := 1;
  263.     Field[i]^[N] := 1;
  264.     Field[0]^[i] := 1;
  265.     Field[N]^[i] := 1;
  266.     END;
  267.  SetValues;
  268.  END;
  269.  
  270.  PROCEDURE XField;
  271. {sets up the spins with a big X}
  272.   VAR
  273.    i, j : INTEGER;
  274.  BEGIN
  275.   FOR i := 0 TO N DO
  276.    FOR j := 0 TO N DO
  277.      Field[i]^[j] := -1;
  278.      
  279.   FOR i := 0 TO N DO
  280.     BEGIN
  281.     Field[i]^[i] := 1;
  282.     Field[i]^[N-i] := 1;
  283.     END;
  284.   
  285.  SetValues;
  286.  END;
  287.  
  288.  PROCEDURE LinedField;
  289. {sets up the spins with a vertical lines}
  290.   VAR
  291.    i, j : INTEGER;
  292.  BEGIN
  293.   FOR i := 0 TO N DO
  294.    FOR j := 0 TO N DO
  295.      IF BitAnd(j,1) = 1 THEN
  296.        Field[i]^[j] := 1
  297.      ELSE
  298.        Field[i]^[j] := -1;
  299.      
  300.  SetValues;
  301.  END;
  302.  
  303.  PROCEDURE BField;
  304. {sets up the spins with a big letter B}
  305.   VAR
  306.    i, j : INTEGER;
  307.    No2: INTEGER;
  308.  BEGIN
  309.   No2 := N DIV 2;
  310.   
  311.   FOR i := 0 TO N DO
  312.     FOR j := 0 TO N DO
  313.       Field[i]^[j] := -1;
  314.  
  315.   FOR i := 0 TO N DO
  316.     Field[i]^[0] := 1;
  317.   
  318.   FOR j := 0 TO N-1 DO
  319.     BEGIN
  320.     Field[0]^[j] := 1;
  321.     Field[N]^[j] := 1;
  322.     Field[No2]^[j] := 1;
  323.     END;
  324.     
  325.   FOR i := 1 TO No2-1 DO
  326.     Field[i]^[N] := 1;
  327.  
  328.   FOR i := No2+1 TO N-1 DO
  329.     Field[i]^[N] := 1;
  330.  
  331.  SetValues;
  332.  END;
  333.  
  334.  
  335.  
  336.  PROCEDURE DrawCell(r,c: INTEGER);
  337.  {Draws out one cell, erasing the previous state}
  338.  VAR
  339.    x,y: INTEGER;
  340.    cRect: Rect;
  341.    
  342.  BEGIN
  343.  x := c*Spacing+hOffset;
  344.  y := r*Spacing+vOffset;
  345.  SetRect(cRect,x,y,x+Spacing,y+Spacing);
  346.  IF Field[r]^[c] > 0 THEN
  347.    PaintRect(cRect)
  348.  ELSE
  349.    EraseRect(cRect);
  350.  END;
  351.  
  352.  
  353.  PROCEDURE WalkField;
  354.  {draws the whole field on the screan}
  355.  VAR
  356.    i,j: INTEGER;
  357.    TempRect: Rect;
  358.  BEGIN
  359.   i := (N+1)*Spacing+hOffset;
  360.   j := (N+1)*Spacing+vOffset;
  361.   SetRect(TempRect,hOffset-1,vOffset-1,i+1,j+1);
  362.   EraseRect(GenWind^.portRect); {clear area of field}
  363.   FrameRect(TempRect); {outline area of field}
  364.   FOR i := 0 TO N DO
  365.     FOR j := 0 TO N DO
  366.       DrawCell(i,j);
  367.  END;
  368.  
  369. PROCEDURE ShowAverages;
  370. {prints out the current average energy and spin to the screan.}
  371. BEGIN
  372.   setRect(tempRect,340,20,512,225);
  373.   eraseRect(tempRect);
  374.  
  375.   StringOf(kToJ:10:4,TempStr);
  376.   MoveTo(345,40);
  377.   drawString(CONCAT('kT/J = ',TempStr));   
  378.  
  379.   StringOf(NSteps,TempStr);
  380.   MoveTo(345,55);
  381.   drawString(CONCAT('Steps = ',TempStr));   
  382.  
  383.   MoveTo(345,85);
  384.   drawString('Current Values:');   
  385.  
  386.   StringOf(tEAve:8:4,TempStr);
  387.   MoveTo(345,100);
  388.   drawString(CONCAT('E = ',TempStr));   
  389.  
  390.   StringOf(tESqAve:8:4,TempStr);
  391.   MoveTo(345,115);
  392.   drawString(CONCAT('E^2 = ',TempStr));   
  393.   
  394.   StringOf(tSpinAve:8:4,TempStr);
  395.   MoveTo(345,130);
  396.   drawString(CONCAT('S = ',TempStr));   
  397.   
  398.   MoveTo(345,160);
  399.   drawString('Averaged Values:');   
  400.  
  401.   StringOf(EAve:8:4,TempStr);
  402.   MoveTo(345,175);
  403.   drawString(CONCAT('<E> = ',TempStr));   
  404.  
  405.   StringOf(ESqAve:8:4,TempStr);
  406.   MoveTo(345,190);
  407.   drawString(CONCAT('<E^2> = ',TempStr));   
  408.   
  409.   StringOf(SpinAve:8:4,TempStr);
  410.   MoveTo(345,205);
  411.   drawString(CONCAT('<S> = ',TempStr));   
  412.   
  413.   StringOf(NSpins*(ESqAve-EAve*EAve)/kToJ/kToJ:8:4,TempStr);
  414.   MoveTo(345,220);
  415.   drawString(CONCAT('C = ',TempStr));   
  416. END; 
  417.  
  418. PROCEDURE doUpdate;
  419. {updates the screan in responce to a system update event}
  420. BEGIN
  421.   BeginUpdate(GenWind);
  422.   WalkField;
  423.   ShowAverages;
  424.   EndUpdate(GenWind);
  425. END;
  426.   
  427.  
  428.  PROCEDURE MakeLookup (kToJ : REAL);
  429. {Sets up the exp lookup table.  This table holds number from zero to}
  430. {RandRange, and takes delta E as its index}
  431.   VAR
  432.    i : INTEGER;
  433.  BEGIN
  434.   FOR i := 1 TO TSize DO
  435.    ExpLookup[i] := Round(RandRange * exp(-i / kToJ) - 0.5);
  436.  END;
  437.  
  438.  
  439.  PROCEDURE MonteCarloI (lNSteps : INTEGER;
  440.                        VAR EAve, ESqAve, SpinAve : REAL);
  441. {Does lNSteps of Monte Carlo integration using the weighting function}
  442. {in ExpLookup (which determines the effective kT/J), and returns the }
  443. {average energy, the average energy squared, the average spin, and the}
  444. {average spin squared.}
  445. {This version uses 32 bit integer variables to handle smallish fields.}
  446.   VAR
  447.    i : INTEGER;            {Index counter}
  448.    r, c : INTEGER;         {random indicies}
  449.    DelE : INTEGER;         {change in energy FOR flipping (r,c)}
  450.    SumE : LongInt;         {The sum of all the total energies so far}
  451.    SumESq : LongInt;       {The sum of all the total energies squared so far}
  452.    SumSpin : LongInt;      {The sum of all the total spins so far}
  453.    TempSpin : INTEGER;     {The spin of the cell being tested}
  454.    aCount,bCount: INTEGER; {index counters for wait}
  455.   
  456.  BEGIN
  457.   SumE := 0;
  458.   SumESq := 0;
  459.   SumSpin := 0;
  460.   FOR i := 1 TO lNSteps DO     {loop over number of integration steps}
  461.    BEGIN
  462.     IF Speed <> 1 THEN
  463.       FOR aCount := 1 TO Speed DO
  464.         FOR bCount := 1 TO WaitCount DO {nothing} ;
  465.    
  466.     r := ABS(Random) MOD Np1;
  467.     c := ABS(Random) MOD Np1;       {select a random spin}
  468.     TempSpin := Field[r]^[ c];      {store the current state of the spin}
  469.     DelE := 2 * TempSpin * (Field[r]^[ (c + 1) MOD Np1] + 
  470.                             Field[r]^[ (Np1 + c - 1) MOD Np1] + 
  471.                 Field[(r + 1) MOD Np1]^[ c] + 
  472.                 Field[(Np1 + r - 1) MOD Np1]^[ c]);
  473.                   {calculate the delta E for flipping this selection}
  474.     IF DelE <= 0 THEN {accept right away}
  475.      BEGIN
  476.       Field[r]^[ c] := -TempSpin;  {flip the cell}
  477.       DrawCell(r,c);
  478.       CurE := CurE + DelE;         {Update the current total energy}
  479.       CurESq := CurE * CurE;
  480.       CurSpin := CurSpin - 2 * TempSpin;
  481.      END
  482.     ELSE IF ExpLookup[DelE] > ABS(Random) THEN {is small enough increase}
  483.      BEGIN
  484.       Field[r]^[ c] := -TempSpin;  {flip the cell}
  485.       DrawCell(r,c);
  486.       CurE := CurE + DelE;         {Update the current total energy}
  487.       CurESq := CurE * CurE;
  488.       CurSpin := CurSpin - 2 * TempSpin;
  489.      END;
  490.     SumE := SumE + CurE;         {Add the current state to the integration}
  491.     SumESq := SumESq + CurESq;
  492.     SumSpin := SumSpin + CurSpin;
  493.    END;
  494.   EAve := SumE / lNSteps / NSpins;
  495.   ESqAve := SumESq / lNSteps / NSpins / NSpins;
  496.   SpinAve := SumSpin / lNSteps / NSpins;   {return the average values}
  497.  END;
  498.  
  499.  PROCEDURE MonteCarloR (lNSteps : INTEGER;
  500.                        VAR EAve, ESqAve, SpinAve : REAL);
  501. {Does lNSteps of Monte Carlo integration using the weighting function}
  502. {in ExpLookup (which determines the effective kT/J), and returns the }
  503. {average energy, the average energy squared, the average spin, and the}
  504. {average spin squared.}
  505. {This version uses 80 bit integer variables to handle very large fields.}
  506.   VAR
  507.    i : INTEGER;            {Index counter}
  508.    r, c : INTEGER;         {random indicies}
  509.    DelE : INTEGER;         {change in energy FOR flipping (r,c)}
  510.    SumE : Comp;            {The sum of all the total energies so far}
  511.    SumESq : Comp;          {The sum of all the total energies squared so far}
  512.    SumSpin : Comp;         {The sum of all the total spins so far}
  513.    TempSpin : INTEGER;     {The spin of the cell being tested}
  514.    aCount,bCount: INTEGER; {index counters for wait}
  515.   
  516.  BEGIN
  517.   SumE := 0;
  518.   SumESq := 0;
  519.   SumSpin := 0;
  520.   FOR i := 1 TO lNSteps DO     {loop over number of integration steps}
  521.    BEGIN
  522.     IF Speed <> 1 THEN
  523.       FOR aCount := 1 TO Speed DO
  524.         FOR bCount := 1 TO WaitCount DO {nothing} ;
  525.    
  526.     r := ABS(Random) MOD Np1;
  527.     c := ABS(Random) MOD Np1;         {select a random spin}
  528.     TempSpin := Field[r]^[ c];        {store the current state of the spin}
  529.     DelE := 2 * TempSpin * (Field[r]^[ (c + 1) MOD Np1] + 
  530.                             Field[r]^[ (Np1 + c - 1) MOD Np1] + 
  531.                 Field[(r + 1) MOD Np1]^[ c] + 
  532.                 Field[(Np1 + r - 1) MOD Np1]^[ c]);
  533.                   {calculate the delta E for flipping this selection}
  534.     IF DelE <= 0 THEN {accept right away}
  535.      BEGIN
  536.       Field[r]^[ c] := -TempSpin;  {flip the cell}
  537.       DrawCell(r,c);
  538.       CurE := CurE + DelE;         {Update the current total energy}
  539.       CurESq := CurE * CurE;
  540.       CurSpin := CurSpin - 2 * TempSpin;
  541.      END
  542.     ELSE IF ExpLookup[DelE] > ABS(Random) THEN {is small enough increase}
  543.      BEGIN
  544.       Field[r]^[ c] := -TempSpin;  {flip the cell}
  545.       DrawCell(r,c);
  546.       CurE := CurE + DelE;         {Update the current total energy}
  547.       CurESq := CurE * CurE;
  548.       CurSpin := CurSpin - 2 * TempSpin;
  549.      END;
  550.     SumE := SumE + CurE;         {Add the current state to the integration}
  551.     SumESq := SumESq + CurESq;
  552.     SumSpin := SumSpin + CurSpin;
  553.    END;
  554.   EAve := SumE / lNSteps / NSpins;
  555.   ESqAve := SumESq / lNSteps/ NSpins / NSpins;
  556.   SpinAve := SumSpin / lNSteps/ NSpins;   {return the average values}
  557.  END;
  558.  
  559.  PROCEDURE EqMonteCarlo (lNSteps : INTEGER);
  560. {Just like MonteCarlo, except this one does not return or calculate}
  561. {anything.  It is used for fast equilibration.}
  562.   VAR
  563.    i : INTEGER;            {Index counter}
  564.    r, c : INTEGER;         {random indicies}
  565.    DelE : INTEGER;         {change in energy FOR flipping (r,c)}
  566.    TempSpin : INTEGER;     {The spin of the cell being tested}
  567.    aCount,bCount: INTEGER; {index counters for wait}
  568.   
  569.  BEGIN
  570.   FOR i := 1 TO lNSteps DO     {loop over number of integration steps}
  571.    BEGIN
  572.     IF Speed <> 1 THEN
  573.       FOR aCount := 1 TO Speed DO
  574.         FOR bCount := 1 TO WaitCount DO {nothing} ;
  575.    
  576.     r := ABS(Random) MOD Np1;
  577.     c := ABS(Random) MOD Np1;         {select a random spin}
  578.     TempSpin := Field[r]^[ c];        {store the current state of the spin}
  579.     DelE := 2 * TempSpin * (Field[r]^[ (c + 1) MOD Np1] + 
  580.                             Field[r]^[ (Np1 + c - 1) MOD Np1] + 
  581.                 Field[(r + 1) MOD Np1]^[ c] + 
  582.                 Field[(Np1 + r - 1) MOD Np1]^[ c]);
  583.                   {calculate the delta E for flipping this selection}
  584.     IF DelE <= 0 THEN {accept right away}
  585.       BEGIN
  586.       Field[r]^[ c] := -TempSpin;    {flip the cell}
  587.       DrawCell(r,c);
  588.       END
  589.     ELSE IF ExpLookup[DelE] > ABS(Random) THEN {is small enough increase}
  590.       BEGIN
  591.       Field[r]^[ c] := -TempSpin;    {flip the cell}
  592.       DrawCell(r,c);
  593.       END;
  594.    END;
  595.  END;
  596.  
  597.  
  598.  
  599.  
  600.  
  601.  
  602. {----------------------------------------------------------------------------------}
  603. {support procedures and functions start here}
  604.  
  605.  
  606. PROCEDURE SetUpMenus;
  607. { Set up menus and menu bar }
  608.  
  609.   VAR i: INTEGER;
  610.  
  611.   BEGIN
  612.   { Read menu descriptions from resource file into memory and store handles }
  613.   { in myMenus array }
  614.   myMenus[appleM] := GetMenu(appleID); {read Apple menu from resource file}
  615.   AddResMenu(myMenus[appleM],'DRVR');  {add desk accessory names to Apple menu}
  616.   myMenus[fileM] := GetMenu(fileID);   {read File menu from resource file}
  617.   myMenus[editM] := GetMenu(editID);   {read Edit menu from resource file}
  618.   myMenus[FirstM] := GetMenu(Menu1ID); {read first menu from resource file}
  619.   myMenus[SecondM] := GetMenu(Menu2ID);{read second menu from resource file}
  620.  
  621.   FOR i:=1 TO menuCount DO InsertMenu(myMenus[i],0);  {install menus in menu bar }
  622.   DrawMenuBar;                                        { and draw menu bar}
  623.   
  624.   Averaging := TRUE;                       {default is to display averages}
  625.   CheckItem(myMenus[FirstM],M1YesAve,TRUE);
  626.   CheckItem(myMenus[FirstM],M1NoAve,FALSE);
  627.   END;    {of SetUpMenus}
  628.  
  629.  
  630. PROCEDURE GetSize(VAR lresult: INTEGER);
  631. {puts up a dialog to get the new size of the field.}
  632. VAR tDialog: DialogPtr;
  633.     theItem: INTEGER;
  634.     tHandle: Handle;
  635.     dummy: INTEGER;
  636.  
  637. BEGIN
  638.   tDialog := GetNewDialog(257,NIL,POINTER(-1));
  639.   ModalDialog(NIL,theItem);
  640.   IF theItem = 1 THEN
  641.     BEGIN
  642.     GetDItem(tDialog,4,dummy,tHandle,tempRect);
  643.     GetIText(tHandle,tempStr);
  644.     IF LENGTH(tempStr) = 0 THEN
  645.       lInteger := 0
  646.     ELSE
  647.       StringToNum(tempStr,lInteger);
  648.     lresult := LoWord(linteger);
  649.     END;
  650.   DisposDialog(tDialog);
  651.   IF (lresult < 2) OR (lresult > MaxN) THEN
  652.     lresult := 10;
  653. END;
  654.  
  655. PROCEDURE GetTemp(VAR lresult: REAL);
  656. {puts up a dialog to get the new temperature of the field.}
  657. VAR tDialog: DialogPtr;
  658.     theItem: INTEGER;
  659.     tHandle: Handle;
  660.     dummy: INTEGER;
  661.  
  662. BEGIN
  663.   tDialog := GetNewDialog(258,NIL,POINTER(-1));
  664.   ModalDialog(NIL,theItem);
  665.   IF theItem = 1 THEN
  666.     BEGIN
  667.     GetDItem(tDialog,4,dummy,tHandle,tempRect);
  668.     GetIText(tHandle,tempStr);
  669.     IF LENGTH(tempStr) <> 0 THEN
  670.       BEGIN
  671.       Rewrite(tFile);
  672.       Writeln(tFile,tempStr);
  673.       Reset(tFile);
  674.       Readln(tFile,lResult);
  675.       END;
  676.     END;
  677.   DisposDialog(tDialog);
  678. END;
  679.  
  680. PROCEDURE TellSpeed;
  681. {puts up a dialog to tell the user to type a number to change the speed.}
  682. VAR tDialog: DialogPtr;
  683.     theItem: INTEGER;
  684.     tHandle: Handle;
  685.     dummy: INTEGER;
  686.  
  687. BEGIN
  688.   tDialog := GetNewDialog(259,NIL,POINTER(-1));
  689.   ModalDialog(NIL,theItem);
  690.   DisposDialog(tDialog);
  691. END;
  692.  
  693. PROCEDURE doAboutBox;
  694. {puts up a the About IsingGraf dialog box.}
  695. VAR tDialog: DialogPtr;
  696.     theItem: INTEGER;
  697.     tHandle: Handle;
  698.     dummy: INTEGER;
  699.  
  700. BEGIN
  701.   tDialog := GetNewDialog(260,NIL,POINTER(-1));
  702.   ModalDialog(NIL,theItem);
  703.   DisposDialog(tDialog);
  704. END;
  705.  
  706.  
  707. {----------------------------------------------------------------------------------}
  708. PROCEDURE DoCommand (mResult: LONGINT);
  709. { Execute command specified by mResult, the result of MenuSelect }
  710.  
  711.   VAR theItem: INTEGER;  {menu item number from mResult low-order word}
  712.       theMenu: INTEGER;  {menu number from mResult high-order word}
  713.       name: Str255;      {desk accessory name}
  714.       temp: INTEGER;
  715.       savePort: GrafPtr; {temporary save of grafport}
  716.       i,j,n1: INTEGER;
  717.  
  718.  
  719.   BEGIN {PROCEDURE DoCommand}
  720.   theItem := LoWord(mResult);
  721.   theMenu := HiWord(mResult);             {set menu item number and menu number}
  722.  
  723.   CASE theMenu OF                         {case on menu ID}
  724.  
  725.   appleID:
  726.     BEGIN
  727.     IF theItem = 1 THEN
  728.       doAboutBox
  729.     ELSE
  730.       BEGIN
  731.       GetItem(myMenus[appleM],theItem,name);  {get name of desk accesory}
  732.       GetPort(SavePort);
  733.       temp := OpenDeskAcc(name);              {open desk accesory}
  734.       SetPort(SavePort);
  735.       END
  736.     END;    {of appleID}
  737.  
  738.   fileID:         {quit}
  739.      BEGIN
  740.      Close(tFile);
  741.      ExitToShell;        {quit}
  742.      END;
  743.  
  744.   editID:
  745.     BEGIN                         {call Desk Manager to handle editing command if }
  746.     IF NOT SystemEdit(theItem-1) THEN  {desk accessory window is the active window}
  747.                                        {application window is the active window}
  748.       BEGIN
  749.       CASE theItem OF
  750.     undoCommand:
  751.       BEGIN
  752.       END;
  753.     cutCommand:
  754.       BEGIN
  755.       END;
  756.     copyCommand:
  757.       BEGIN
  758.       END;
  759.     pasteCommand:
  760.       BEGIN
  761.       END;
  762.     clearCommand:
  763.       BEGIN
  764.       END;
  765.     cSpecialCommand:
  766.       BEGIN
  767.       END;
  768.         END;
  769.       END
  770.     END;
  771.  
  772.   Menu1ID:  {control menu}
  773.     CASE theItem OF
  774.     M1NewSize: {New Field Size Item}
  775.          BEGIN
  776.      GetSize(Np1);    {put up dialog for new size}
  777.      N := Np1-1;
  778.      Nm1 := N - 1;
  779.      NSpins := Np1 * Np1; {Set the dimension variables}
  780.      
  781.      Spacing := 250 DIV Np1;
  782.      IF Spacing < 1 THEN
  783.        Spacing := 1;
  784.      hOffset := 5;
  785.      vOffset := 5;  {Set the plotting variables to defaults}
  786.  
  787.      tComp := 1;
  788.      tComp := tComp*Np1*Np1*2*Np1*Np1*2*FewSteps;
  789.      IF tComp > 2000000000 THEN
  790.        VeryBig := TRUE
  791.      ELSE
  792.        VeryBig := FALSE;
  793.          
  794.      RandField;     
  795.      SetValues;
  796.  
  797.      InvalRect(GenWind^.portRect);
  798.      doUpdate;
  799.          END;
  800.     M1NewTemp:
  801.          BEGIN {New Temperature Item}
  802.      GetTemp(kToJ); {put up dialog for new temp}
  803.          MakeLookup(kToJ);
  804.      SetValues;
  805.      InvalRect(GenWind^.portRect);
  806.      doUpdate;
  807.          END;
  808.     M1YesAve:
  809.          BEGIN {Display Averages Item}
  810.      Averaging := TRUE;
  811.      SetValues;
  812.      CheckItem(myMenus[FirstM],M1YesAve,TRUE);
  813.      CheckItem(myMenus[FirstM],M1NoAve,FALSE);
  814.          END;
  815.     M1NoAve:
  816.          BEGIN {Don't Display Averages Item}
  817.      Averaging := FALSE;
  818.      CheckItem(myMenus[FirstM],M1YesAve,FALSE);
  819.      CheckItem(myMenus[FirstM],M1NoAve,TRUE);
  820.          END;
  821.     M1NewAve:
  822.          BEGIN {Reset Averages Item}
  823.      IF Averaging = TRUE THEN
  824.        SetValues;
  825.          END;
  826.     M1Speed:
  827.          BEGIN  {speed item}
  828.      TellSpeed;
  829.      END;
  830.       END; {case of Menu1ID}
  831.  
  832.   Menu2ID: {Setup Menu}
  833.     CASE theItem OF
  834.     M2Item1: {Random Field Item}
  835.          BEGIN
  836.      RandField;
  837.      InvalRect(GenWind^.portRect);
  838.      doUpdate;
  839.          END;
  840.     M2Item2: {Checkboard Field Item}
  841.          BEGIN
  842.      CheckField;
  843.      InvalRect(GenWind^.portRect);
  844.      doUpdate;
  845.          END;
  846.     M2Item3: {Interface Field Item}
  847.          BEGIN
  848.      IntfField;
  849.      InvalRect(GenWind^.portRect);
  850.      doUpdate;
  851.          END;
  852.     M2Item4: {Big Spot Field Item}
  853.          BEGIN
  854.      SpotField;
  855.      InvalRect(GenWind^.portRect);
  856.      doUpdate;
  857.          END;
  858.     M2Item5: {Ring Field Item}
  859.          BEGIN
  860.      RingField;
  861.      InvalRect(GenWind^.portRect);
  862.      doUpdate;
  863.          END;
  864.     M2Item6: {X Field Item}
  865.          BEGIN
  866.      XField;
  867.      InvalRect(GenWind^.portRect);
  868.      doUpdate;
  869.          END;
  870.     M2Item7: {Lined Field Item}
  871.          BEGIN
  872.      LinedField;
  873.      InvalRect(GenWind^.portRect);
  874.      doUpdate;
  875.          END;
  876.     M2Item8: {B Field Item}
  877.          BEGIN
  878.      BField;
  879.      InvalRect(GenWind^.portRect);
  880.      doUpdate;
  881.          END;
  882.       END;
  883.  
  884.   END;    {of menu case}          {to indicate completion of command, call }
  885.   HiliteMenu(0);                  {Menu Manager to unhighlight menu title  }
  886.                                   {(highlighted by MenuSelect)             }
  887.   END;  {of DoCommand}
  888.  
  889.  
  890.  
  891. {----------------------------------------------------------------------------------}
  892. PROCEDURE MainLoop;
  893.  
  894.   BEGIN
  895.  
  896.   SystemTask;                             {do desk accessories}
  897.  
  898.   IF GetNextEvent(everyEvent,myEvent) {call Toolbox Event Manager to get the next }
  899.     THEN                              { event that the application should handle}
  900.       CASE myEvent.what OF            {case on event type}
  901.  
  902.       mouseDown:            {mouse button down:  call Window Manager to learn where}
  903.         CASE FindWindow(myEvent.where,whichWindow) OF
  904.  
  905.         inSysWindow:        {desk accessory window: call Desk Manager to handle it}
  906.           SystemClick(myEvent,whichWindow);
  907.  
  908.         inMenuBar:          {menu bar:  call Menu Manager to learn which command; }
  909.           DoCommand(MenuSelect(myEvent.where)); { then execute it}
  910.  
  911.         inContent:
  912.           BEGIN
  913.           IF whichWindow <> FrontWindow THEN
  914.             SelectWindow(whichWindow)
  915.           ELSE
  916.             BEGIN
  917.             END;
  918.           END     {of inContent}
  919.  
  920.         END;    {of mouseDown}
  921.  
  922.      keyDown, autoKey:              {key pressed once or held down to repeat}
  923.         BEGIN
  924.         theChar := CHR(BitAnd(myEvent.message,charCodeMask));  {get the character}
  925.         IF BitAnd(myEvent.modifiers,cmdKey) <> 0  THEN { if Command key down,    }
  926.           DoCommand(MenuKey(theChar))                  { execute it              }
  927.         ELSE
  928.           BEGIN
  929.       IF (theChar >= '0') AND (theChar <= '9') THEN
  930.         BEGIN
  931.         Speed := Ord('9') - Ord(theChar);
  932.         Speed := BitSL(1,Speed);
  933.         IF Speed = 1 THEN
  934.           FewSteps := 400
  935.         ELSE
  936.           BEGIN
  937.           FewSteps := 50 DIV Speed;
  938.           IF FewSteps < 1 THEN
  939.             FewSteps := 1;
  940.           END
  941.         END;
  942.           END;
  943.         END;
  944.  
  945.       activateEvt:
  946.       BEGIN
  947.       IF BitAnd(myEvent.modifiers,activeFlag) <> 0 THEN   {window becoming active}
  948.         IF myEvent.message = Ord4(GenWind) THEN
  949.           BEGIN
  950.           SelectWindow(GenWind);
  951.           SetPort(GenWind);
  952.           END
  953.         ELSE
  954.           BEGIN                  {application window is becoming inactive: }
  955.           END;
  956.       END;   {of activateEvt}
  957.  
  958.       updateEvt:
  959.         BEGIN
  960.     doUpdate;
  961.         END
  962.  
  963.      END;    {of event case}
  964.  
  965. END; {main loop}
  966.  
  967.  
  968.  
  969.  
  970. BEGIN  {Kgraph}
  971. { Initialization }
  972. InitGraf(@thePort);           {initialize QuickDraw}
  973. InitFonts;                    {initialize Font Manager}
  974. FlushEvents(everyEvent,0);    {call OS Event Manager to discard any previous events}
  975. InitWindows;                  {initialize Window Manager}
  976. InitMenus;                    {initialize Menu Manager}
  977. TEInit;                       {initialize TextEdit}
  978. InitDialogs(NIL);             {initialize Dialog Manager}
  979. InitCursor;                   {call QuickDraw to make cursor (pointer) an arrow}
  980.  
  981. SetUpMenus;                   {set up menus and menu bar}
  982.  
  983. WITH screenBits.bounds DO     {call QuickDraw to set dragging boundaries; ensure at }
  984.   SetRect(dragRect,4,24,right-4,bottom-4); { least 4 by 4 pixels will remain visible}
  985.  
  986. GenWind := GetNewWindow(windowID,@GenWRecord,POINTER(-1)); {put up window}
  987.  
  988. hCurs := GetCursor (iBeamCursor);
  989. iBeam := hCurs^^;                              {get I-beam cursor}
  990.  
  991. SelectWindow(GenWind);
  992. SetPort(GenWind);
  993.  
  994. Open(tFile,tempName);   {open the stupid text file}
  995.  
  996.  
  997.  
  998.  
  999.  lInteger := SizeOf(RowType);
  1000.  FOR i := 0 TO MaxN DO
  1001.    Field[i] := RowPtr(NewPtr(lInteger));   {allocate the field}
  1002.  
  1003.  N := 10;
  1004.  Nm1 := N - 1;
  1005.  Np1 := N + 1;
  1006.  NSpins := Np1 * Np1;   {Set the dimension variables to starting defaults}
  1007.  
  1008.  Speed := 1;
  1009.  FewSteps := 400;
  1010.  
  1011.  Spacing := 250 DIV Np1;
  1012.  IF Spacing < 1 THEN
  1013.    Spacing := 1;
  1014.  hOffset := 5;
  1015.  vOffset := 5;          {Set the plotting variables to starting defaults}
  1016.  
  1017.  tComp := 1;
  1018.  tComp := tComp*Np1*Np1*2*Np1*Np1*2*FewSteps;
  1019.  IF tComp > 2000000000 THEN
  1020.    VeryBig := TRUE
  1021.  ELSE
  1022.    VeryBig := FALSE;
  1023.  
  1024.  kToJ := 2.3;    {set default temperature}
  1025.  MakeLookup(kToJ);
  1026.  
  1027.  RandField;
  1028.  WalkField;
  1029.  
  1030.  SetValues;
  1031.  
  1032.  
  1033. REPEAT
  1034.   IF Averaging THEN
  1035.     BEGIN
  1036.     REPEAT
  1037.       IF VeryBig THEN
  1038.         MonteCarloR(FewSteps, tEAve, tESqAve, tSpinAve)
  1039.       ELSE
  1040.         MonteCarloI(FewSteps, tEAve, tESqAve, tSpinAve);
  1041.       invNSteps := 1/(NSteps + FewSteps);
  1042.       EAve := (EAve*NSteps + tEAve*FewSteps)*invNSteps;
  1043.       ESqAve := (ESqAve*NSteps + tESqAve*FewSteps)*invNSteps;
  1044.       SpinAve := (SpinAve*NSteps + tSpinAve*FewSteps)*invNSteps;
  1045.       NSteps := NSteps + FewSteps;
  1046.       ShowAverages;
  1047.     UNTIL EventAvail(everyEvent,myEvent);
  1048.     END
  1049.   ELSE
  1050.     BEGIN
  1051.     REPEAT
  1052.       eqMonteCarlo(FewSteps);
  1053.       NSteps := NSteps + FewSteps;
  1054.     UNTIL EventAvail(everyEvent,myEvent);
  1055.     END;
  1056.  
  1057.   mainloop;
  1058. UNTIL TRUE=FALSE;
  1059. END.
  1060.